home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1999 March
/
EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso
/
earcd
/
-archivi
/
-recent2
/
amicad_2.00.lha
/
AmiCAD
/
ARexx
/
TirerTraits.AmiCAD
< prev
next >
Wrap
Text File
|
1999-02-06
|
4KB
|
195 lines
/* Décalage et alignement des extrémités d'un ensemble de lignes */
/* Version 1.00 13/01/99 */
/* $VER: 1.01 (© R.Florac, 6/2/99) Ajout UNLOCK */
options results
signal on error
signal on syntax
'DEF LIGNE(P)=P&0XFFFF'
'DEF COLONNE(P)=P>>15'
'LOCK(-1):SELECT("Bout à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
d=result
select
when d=1 then do
'GETPOINT("Cliquez sur la colonne de destination")'; p=result
/* 'PLACEOBJ("Placez la ligne sur sa destination", FIRSTSEL, 0)'; p=result */
if p<0 then exit
'COLONNE('p')'; col=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_gauche(o,col,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=2 then do
'GETPOINT("Cliquez sur la ligne de destination")'; p=result
if p<0 then exit
'LIGNE('p')'; ligne=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_haut(o,ligne,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=3 then do
'GETPOINT("Cliquez sur la colonne de destination")'; p=result
if p<0 then exit
'COLONNE('p')'; col=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_droite(o,col,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
when d=4 then do
'GETPOINT("Cliquez sur la ligne de destination")'; p=result
if p<0 then exit
'LIGNE('p')'; ligne=result
'SAVEALL(-1):FIRSTSEL'; o=result
do while o>0
mode=mode_ligne(o)
if mode~=-1000 then do
o = retracer_bas(o,ligne,mode)
end
else do
'NEXTSEL('o')'; o=result
end
end
end
otherwise nop
end
'UNLOCK(-1)'
exit
mode_ligne: procedure
parse arg o
mode=-1000
'TYPE('o')'
select
when result=2 then mode=1 /* fil */
when result=15 then mode=2 /* ligne double */
when result=9 then mode=3 /* bus */
when result=8 then mode=0 /* pointillés */
when result=21 then do /* ligne spéciale */
'PENWIDTH('o',-10000)'
mode=0-result
end
otherwise nop
end
return mode
minima: procedure
parse arg v1,v2
if v1<v2 then return v1
return v2
end
maxima: procedure
parse arg v1,v2
if v1>v2 then return v1
return v2
end
retracer_gauche: procedure
parse arg o,col,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
xg=minima(x0,x1)
if x0=x1 then x1=col
if xg=x0 then do
x2=x1; y2=y1;
end
else do
x2=x0; y2=y0; y0=y1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_haut: procedure
parse arg o,ligne,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
yh=minima(y0,y1)
if y0=y1 then y1=ligne
if yh=y0 then do
y2=y1; x2=x1;
end
else do
y2=y0; x2=x0; x0=x1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_droite: procedure
parse arg o,col,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
xd=maxima(x0,x1)
if x0=x1 then x0=col
if xd=x1 then do
x2=x0; y2=y0; y0=y1
end
else do
x2=x1; y2=y1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
retracer_bas: procedure
parse arg o,ligne,mode
'COORDS('o')'
PARSE VAR result x0 ',' y0 ',' x1 ',' y1
yb=maxima(y0,y1)
if y0=y1 then y1=ligne
if yb=y0 then do
y2=y1; x2=x1;
end
else do
y2=y0; x2=x0; x0=x1
end
'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
if no=o then o=0
else do
'NEXTSEL('o-1')'; o=result
end
return o
/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK(-1)'
exit
error:
'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK(-1)'
exit